Software Vault: The Gold Collection/Software Vault - The Gold Collection (American Databankers) (1993).ISO/cdr53/pctv4n_1.zip/CONCEN.TXT

Text File | 1993-06-10 | 5KB | 202 lines

' Listing 2 - Concen.Frm
Const MAX_MATCH = 20

Dim CrLf As String

Dim PiecesLoaded As Integer
Dim CurrentPlayer As Integer
Dim NumShown As Integer
Dim Piece1 As Integer
Dim Piece2 As Integer
Dim PlayingGame As Integer
Dim MatchesMade As Integer

Sub NewCmd_Click ()
ReDim TrackUsed(1 To 20) As Integer
Dim Selection As Integer, PicSelected As Integer
Dim i As Integer

    ' Initialize game variables
    InitPlayerRecs
    MousePointer = HOURGLASS

    ' Load the game pieces if not already done.
    If Not PiecesLoaded% Then
        For i% = 1 To 39
            Load btnGamePiece(i%)
            InitGamePiece btnGamePiece(i%)
        Next i%
        PiecesLoaded% = TRUE
    End If

    Piece1% = -1
    Piece2% = -1
    MatchesMade% = 0
    PlayingGame = TRUE

    ' Shuffle the pieces
    Randomize Timer
    For i% = 0 To 39
        PicSelected% = FALSE
        Do
            Selection% = Int(Rnd(1) * 20) + 1
            If TrackUsed(Selection%) < 2 Then
                PicSelected% = TRUE
                TrackUsed(Selection%) = TrackUsed(Selection%) + 1
                SetPic btnGamePiece(i%), Selection%
            End If
        Loop Until PicSelected%
    Next i%

    MousePointer = DEFAULT
    MsgBox "Ready to start game.", MB_ICONINFORMATION, "New Game"
End Sub


Sub ExitCmd_Click ()
    End
End Sub

Sub Form_Load ()
    CrLf$ = Chr$(13) + Chr$(10) ' Initialize CrLf$
End Sub

Sub btnGamePiece_Click (Index As Integer)
Dim NewScore As Integer

    If Index = Piece1% Then
        btnGamePiece(Index).Frame = 2
        btnGamePiece(Index).Value = 2
        Exit Sub
    End If

    NumShown% = NumShown% + 1

    If PlayingGame Then
        Select Case NumShown%
            Case 1
                Piece1% = Index
            Case 2
                Piece2% = Index
                If btnGamePiece(Piece1%).Tag = btnGamePiece(Piece2%).Tag Then
                    MessageBeep (MB_ICONINFORMATION)
                    MsgBox "You made a match!", MB_ICONINFORMATION, "A Match!"
                    btnGamePiece(Piece1%).Visible = FALSE
                    btnGamePiece(Piece2%).Visible = FALSE
                    NumShown% = 0
                    Piece1% = -1
                    Piece2% = -1
                    NewScore% = Players(CurrentPlayer).Score
                    NewScore% = NewScore% + 1
                    Players(CurrentPlayer).Score = NewScore%
                    PlayerScore(CurrentPlayer - 1).Caption = Str$(NewScore%)
                    MatchesMade% = MatchesMade% + 1
                Else
                    Timer1.Interval = 3000 / Players(CurrentPlayer).Level
                    Timer1.Enabled = TRUE
                End If
            Case 3
                btnGamePiece(Index).Value = 1
                btnGamePiece(Index).Frame = 1
                NumShown% = 2
        End Select
    Else
        MsgBox "Start a new game first!", MB_ICONEXCLAMATION, "Error"
    End If
    If MatchesMade% >= MAX_MATCH Then
        AnnounceWinner
    End If
End Sub

Sub Timer1_Timer ()
    btnGamePiece(Piece1%).Value = 1
    btnGamePiece(Piece2%).Value = 1
    NumShown% = 0
    Piece1% = -1
    Piece2% = -1
    Timer1.Enabled = FALSE
    If CurrentPlayer = 1 Then
        PlayerName(0).BackColor = QBColor(15)
        PlayerName(1).BackColor = QBColor(7)
        CurrentPlayer = 2
    Else
        PlayerName(1).BackColor = QBColor(15)
        PlayerName(0).BackColor = QBColor(7)
        CurrentPlayer = 1
    End If
End Sub

Sub AnnounceWinner ()
Dim Msg As String, Title As String

    If Players(1).Score > Players(2).Score Then
        Msg$ = Players(1).Name + " is the winner!"
        Title$ = "Congratulations!"
    ElseIf Players(1).Score < Players(2).Score Then
        Msg$ = Players(2).Name + " is the winner!"
        Title$ = "Congratulations!"
    Else
        Msg$ = "The game was tied!"
        Title$ = "No Winner"
    End If
    MsgBox Msg$, MB_ICONEXCLAMATION, Title$
    PlayingGame = FALSE
End Sub

Sub InitPlayerRecs ()
Dim i As Integer

    For i% = 1 To 2
        Players(i%).Level = 1
    Next i%
    PlayerInfoForm.Show MODAL
    Unload PlayerInfoForm
    CurrentPlayer = 1
    For i% = 1 To 2
        PlayerName(i% - 1).Caption = Players(i%).Name
    Next i%
    PlayerName(CurrentPlayer - 1).BackColor = QBColor(7)
End Sub

Sub SetPic (PicBox As Control, PicNum As Integer)
    PicBox.Frame = 2
    PicSet.Frame = PicNum%
    PicBox.Picture = PicSet.Picture
    PicBox.Tag = Str$(PicNum%)
    PicBox.Frame = 1
    PicBox.Value = 1
    PicBox.Enabled = TRUE
    PicBox.Visible = TRUE
End Sub

Sub InitGamePiece (Piece As Control)
Static X, Y

    ' Make sure x and y are only initialized the
    ' first time the Sub gets called.
    If X = 0 Then
        X = 720
        Y = 120
    End If
    Piece.Left = X
    Piece.Top = Y
    ' Piece.Picture = Source.Picture
    X = X + 600
    If X > 5520 Then
        X = 120
        Y = Y + 600
    End If
End Sub

Sub AboutCmd_Click ()
    AboutBox.Show MODAL
    Unload AboutBox
End Sub

Sub Form_Unload (Cancel As Integer)
    For i% = 1 To 39
        Unload btnGamePiece(i%)
    Next i%
End Sub